Disaggregated Tagging Patterns
Janette Avelar
2023-06-02
What are the top tags selected when disaggregated?
By locale
disag_locale <- full %>%
select(school_id, locale = exclusive_locale, starts_with("practices")) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(locale, tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
group_by(locale) %>%
arrange(desc(n), .by_group = TRUE) %>%
slice(1:5)## `summarise()` has grouped output by 'locale'. You can override using the
## `.groups` argument.# urban
urban_plot <- disag_locale %>%
filter(locale == "Urban") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[1]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Urban Schools",
x = "",
y = "percentage of urban schools")
urban_plot
# suburban
suburban_plot <- disag_locale %>%
filter(locale == "Suburban") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[2]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Suburban Schools",
x = "",
y = "percentage of suburban schools")
suburban_plot
# rural
rural_plot <- disag_locale %>%
filter(locale == "Rural") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[3]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Rural Schools",
x = "",
y = "percentage of rural schools")
rural_plot
# mixed
mixed_plot <- disag_locale %>%
filter(locale == "Multiple") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[4]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Schools Serving\nStudents from all Geographic Locales",
x = "",
y = "percentage of mixed schools")
mixed_plot
By level
#prekindergarten
disag_pk <- full %>%
select(school_id, grades_prek, starts_with("practices")) %>%
filter(grades_prek == 1) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:5) %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[1]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Pre-Kindergarten Schools",
x = "",
y = "percentage of prek schools")
disag_pk
# elementary schools
disag_elem <- full %>%
select(school_id, grades_elementary, starts_with("practices")) %>%
filter(grades_elementary == 1) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:5) %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[2]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Elementary Schools",
x = "",
y = "percentage of elementary schools")
disag_elem
#middle schools
disag_middle <- full %>%
select(school_id, grades_middle, starts_with("practices")) %>%
filter(grades_middle == 1) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:5) %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[3]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Middle Schools",
x = "",
y = "percentage of middle schools")
disag_middle
#high schools
disag_high <- full %>%
select(school_id, grades_high, starts_with("practices")) %>%
filter(grades_high == 1) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:5) %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[4]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in High Schools",
x = "",
y = "percentage of high schools")
disag_high
By school type
disag_type <- full %>%
select(school_id, type = school_descriptor, starts_with("practices")) %>%
mutate(type = case_when(
type == 1 ~ "District",
type == 2 ~ "Charter",
type == 3 ~ "Independent"
)) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(type, tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
group_by(type) %>%
arrange(desc(n), .by_group = TRUE) %>%
slice(1:5)## `summarise()` has grouped output by 'type'. You can override using the
## `.groups` argument.#Public district schools
district_plot <- disag_type %>%
filter(type == "District") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[1]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Public District Schools",
x = "",
y = "percentage of district schools")
district_plot
#Public charter schools
charter_plot <- disag_type %>%
filter(type == "Charter") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[2]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Public Charter Schools",
x = "",
y = "percentage of charter schools")
charter_plot
#Independent schools
independent_plot <- disag_type %>%
filter(type == "Independent") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[3]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Independent (Private) Schools",
x = "",
y = "percentage of independent schools")
independent_plot
By descriptors
These plots are somewhat misleading and probably should not be displayed due to low N. For homeschools in particular, because there were only 4 schools that described themselves that way and 6 instances where they all selected the same tags, the plot displays a full 100% barchart for all 6 tags. Drawing any conclusions from this would not be a good idea, though.
For reference: homeschool N = 4
hybrid N = 21
microschool N =
school-within-school N =
*virtual N =
#homeschool
disag_homeschool <- full %>%
select(school_id, homeschool = school_descriptor_homeschool, starts_with("practices")) %>%
filter(homeschool == 1) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:6) %>% #pulled 6 because #5 had a tie with another practice -6 tags had 100% selection
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[1]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Homeschools",
subtitle = "Interpret with caution: only 4 homeschools",
x = "",
y = "percentage of homeschools")
disag_homeschool
#hybrid
disag_hybrid <- full %>%
select(school_id, hybrid = school_descriptor_hybrid, starts_with("practices")) %>%
filter(hybrid == 1) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:4) %>% #pulled 4 because 7 tags shared #5 spot
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[2]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Hybrid Schools",
x = "",
y = "percentage of hybrid schools")
disag_hybrid
#microschool
disag_micro <- full %>%
select(school_id, micro = school_descriptor_microschool, starts_with("practices")) %>%
filter(micro == 1) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:5) %>% #top 5 had same rate of selection (87%)
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[3]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Microschools",
subtitle = "The top 5 tags selected for microschools shared the same\nrate of selection",
x = "",
y = "percentage of microschools")
disag_micro
#school within school
disag_sws <- full %>%
select(school_id, sws = school_descriptor_sws, starts_with("practices")) %>%
filter(sws == 1) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:6) %>% #pulled 6 because tie at spot #5
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[4]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Schools-within-schools",
x = "",
y = "percentage of school-within-schools")
disag_sws
#virtualBy leadership team
I collapsed leadership team diversity variable in two:
predominantly White = 0-49% BIPOC leadership
predominantly BIPOC = 50% + BIPOC leadership
disag_lead <- full %>%
select(school_id, lead = leadership_diversity, starts_with("practices")) %>%
filter(!lead == 0) %>%
filter(!lead == 5) %>%
mutate(lead = case_when(
(lead == 1 | lead == 2) ~ "PWI",
(lead == 3 | lead == 4) ~ "BIPOC"
)) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(lead, tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
group_by(lead) %>%
arrange(desc(n), .by_group = TRUE) %>%
slice(1:6) #tie at spot #5 for both groups## `summarise()` has grouped output by 'lead'. You can override using the
## `.groups` argument.#predominantly white
pwled_plot <- disag_lead %>%
filter(lead == "PWI") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[1]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Schools led\nby Predominantly White\nLeadership Team",
x = "",
y = "percentage of schools")
pwled_plot
#BIPOC-led
bipocled_plot <- disag_lead %>%
filter(lead == "BIPOC") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[2]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Schools led\nby Predominantly BIPOC\nLeadership Team",
x = "",
y = "percentage of schools")
bipocled_plot
#combine plots
# combined <-
plot_grid(pwled_plot, bipocled_plot,
ncol = 2)## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Open Sans' not found in PostScript font database## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): font family
## 'Bebas Neue' not found in PostScript font database
# ggsave("finding-17.png", plot = combined, path = here("final_products", "draft-findings"),
# width = 12, height = 8, units = "in")By designing for specific student groups
The plots below pull from all schools that selected
design to meet the needs of students who have been marginalized
and the follow-up question which asks them to specify which
marginalized student group they are designing for.
Which student groups?
The chart below displays the frequency with which Canopy learning environments identified specific student groups as the historically marginalized groups they’re designing their schools for.
marg_freq <- full %>%
select(starts_with("focus"), practices_design_marginalized) %>% #191/251 schools selected
select(!focus_other_student_group_text) %>%
filter(practices_design_marginalized == 1) %>%
mutate(rate = rep(1, nrow(.))) %>%
summarise(across(where(is.numeric), ~ sum(.x, na.rm = TRUE))) %>%
pivot_longer(cols = starts_with("focus"),
names_to = "group",
values_to = "n") %>%
mutate(pct = n/rate,
group = case_when(
group == "focus_bipoc" ~ "BIPOC students",
group == "focus_economic_disadvantage" ~ "Economically Disadvantaged Students",
group == "focus_emergent_bilingual" ~ "Students Classified as English Learners",
group == "focus_foster" ~ "Students in the Foster Care System",
group == "focus_homeless" ~ "Students Experiencing Houselessness",
group == "focus_interrupted" ~ "Students with Interrupted Formal Education",
group == "focus_juvenile_justice" ~ "Students in the Juvenile Justice System",
group == "focus_multilingual" ~ "Multilingual Students",
group == "focus_newcomer" ~ "Newcomer and Recently Arrived Students",
group == "focus_other_student_group" ~ "Other",
group == "focus_swd" ~ "Students with Disabilities"
)) %>%
ggplot(., aes(reorder(group, pct), pct)) +
geom_col(fill = transcend_cols[1]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "When schools are designing for margianlized groups,\nwhich groups are they designing for?",
x = "",
y = "percentage of schools indicating designing for specific student groups")
marg_freq## Warning in labels(...): Missing tag label
# ggsave("finding-18.png", plot = marg_freq, path = here("final_products", "draft-findings"),
# width = 12, height = 8, units = "in")Multilingual students
disag_ml <- full %>%
select(school_id, ml = focus_multilingual, starts_with("practices")) %>%
filter(ml == 1) %>%
select(!practices_design_marginalized) %>% #dropping since all will have chosen
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
arrange(desc(n)) %>%
slice(1:6) %>% #pulled 6 because tie at spot #5
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[4]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Practices in Schools Designing for Multilingual students",
x = "",
y = "percentage of schools")
disag_ml
How many of the schools designing for multilingual learners also utilize dual language programming or heritage language instruction?
Of the schools indicating they were designing specifically for multilingual learners, 18% utilized dual language programming and 13% offered heritage language instruction for their multilingual students. These schools also leverage translanguaging (14%) at double the rate observed in our overall Canopy sample.
#all MLLs
ml<-
full %>%
select(practices_dual_language, practices_heritage_language, practices_translanguaging, focus_multilingual) %>%
filter(focus_multilingual == 1) %>% #111 schools focus on MLLs
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
group_by(tag) %>%
summarize(n = sum(n),
pct = paste0(round(100*(n/111)), "%"))
datatable(ml)The same pattern holds when observing schools designing specifically for students classified as English Learners, though the rates are slightly lower for dual language programming and heritage language instruction.
#ELs specifically
el <-
full %>%
select(practices_dual_language, practices_heritage_language, practices_translanguaging, focus_emergent_bilingual) %>%
filter(focus_emergent_bilingual == 1) %>% #111 schools focus on MLLs
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
group_by(tag) %>%
summarize(n = sum(n),
pct = paste0(round(100*(n/111)), "%"))
datatable(el)Comparative chart
not = data.frame(tag = c("practices_dual_language", "practices_heritage_language", "practices_translanguaging"),
n = c(31, 17, 19),
pct = c(12, 7, 8),
focus = rep("none", 3))
comp_ml <- ml %>%
mutate(focus = rep("MLL", nrow(.))) %>%
bind_rows(el) %>%
mutate(focus = replace_na(focus, "EL")) %>%
mutate(pct = str_remove_all(pct, "[:punct:]"),
pct = as.numeric(pct)) %>%
bind_rows(not) %>%
mutate(pct = pct/100) %>%
ggplot(., aes(tag, pct, fill = focus)) +
geom_bar(position = "dodge", stat = "identity") +
bar_y_scale_percent +
theme(panel.grid.major.x = element_blank()) +
scale_fill_manual(values = transcend_cols,
labels=c('Students Classified as English Learners', 'All Multilingual Students', 'None')) +
labs(title = "Language-Related Practices Used by Schools Focusing on Multilingual Learners",
x = "",
y = "") +
scale_x_tag() +
theme(legend.position = c(.75,.85))
# geom_text(aes(group = focus, label = scales::label_percent(accuracy = 1)(pct)),
# nudge_y = .01,
# vjust = 0,
# color = "black",
# fontface = "bold",
# size = 5,
# family = "sans")
comp_ml
ggsave("finding-19-V2.png", plot = comp_ml, path = here("final_products", "draft-findings"),
width = 12, height = 8, units = "in")Students classified as English Learners
Students with interrupted formal education
Newcomer students
BIPOC students
Economically disadvantaged students
Students in the foster care system
Students experiencing houselessness
Students in the juvenile justice system
Students with disabilities
What are the top core tags selected when disaggregated?
By locale
By level
By school type
By leadership team
I collapsed leadership team diversity variable in two:
predominantly White = 0-49% BIPOC leadership
predominantly BIPOC = 50% + BIPOC leadership
core_lead <- full %>%
select(school_id, lead = leadership_diversity, starts_with("core")) %>%
filter(!lead == 0) %>%
filter(!lead == 5) %>%
mutate(lead = case_when(
(lead == 1 | lead == 2) ~ "PWI",
(lead == 3 | lead == 4) ~ "BIPOC"
)) %>%
rename_all(funs(sub("core", "practices", .))) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(lead, tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
group_by(lead) %>%
arrange(desc(n), .by_group = TRUE) %>%
slice(1:6) #tie at spot #5 for one group## Warning: `funs()` was deprecated in dplyr 0.8.0.
## ℹ Please use a list of either functions or lambdas:
##
## # Simple named list: list(mean = mean, median = median)
##
## # Auto named with `tibble::lst()`: tibble::lst(mean, median)
##
## # Using lambdas list(~ mean(., trim = .2), ~ median(., na.rm = TRUE))
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## `summarise()` has grouped output by 'lead'. You can override using the
## `.groups` argument.#all top 6:
#practices_pbl
#practices_culturally_responsive
#practices_restorative
#practices_sel_integrated
#practices_all_courses_designed_for_inclusion
#practices_design_marginalized
#practices_competency_education
#practices_community_partnerships
#practices_learning_paths
#practices_career_prep
#predominantly white
pwcore_plot <- core_lead %>%
filter(lead == "PWI") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[1]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Core Practices in Schools\nled by Predominantly\nWhite Leadership Team",
x = "",
y = "percentage of schools")
pwcore_plot
#BIPOC-led
bipoccore_plot <- core_lead %>%
filter(lead == "BIPOC") %>%
ggplot(., aes(reorder(tag, pct), pct)) +
geom_col(fill = transcend_cols[2]) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
scale_y_continuous(limits = c(0, 1),
expand = c(0,0),
labels = scales::percent) +
labs(title = "Top Core Practices in Schools\nled by Predominantly\nBIPOC Leadership Team",
x = "",
y = "percentage of schools")
bipoccore_plot
#combine plots
# combined_core <-
plot_grid(pwcore_plot, bipoccore_plot,
ncol = 2)
# ggsave("finding-17b.png", plot = combined_core, path = here("final_products", "draft-findings"),
# width = 12, height = 8, units = "in")Alternate plot: biggest differences in tagging between PW & BIPOC leaders
labs = c("Difference = 14%", "", "Difference = 13%", "", "Difference = 12%","", "Difference = 11%","", "Difference = 10%","", "Difference = 10%","", "Difference = 9%","", "Difference = 8%","", "Difference = 8%", "", "Difference = 6%", "")
diff_core <- full %>%
select(school_id, lead = leadership_diversity, starts_with("core")) %>%
filter(!lead == 0) %>%
filter(!lead == 5) %>%
mutate(lead = case_when(
(lead == 1 | lead == 2) ~ "White",
(lead == 3 | lead == 4) ~ "BIPOC"
)) %>%
rename_all(funs(sub("core", "practices", .))) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(lead, tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
pivot_wider(names_from = lead,
values_from = c(n, rate, pct)) %>%
mutate(diff = abs(round(100*(pct_BIPOC - pct_White), 2))) %>%
pivot_longer(cols = !c(tag, diff),
names_to = c("col", "Leadership Team"),
names_sep = "_",
values_to = "value") %>%
pivot_wider(names_from = col,
values_from = value) %>%
arrange(desc(diff)) %>%
slice(1:20) %>%
ggplot(., aes(reorder(tag, -diff), pct, fill = `Leadership Team`)) +
geom_bar(position = "dodge", stat = "identity") +
scale_y_continuous(limits = c(0, .55), expand = c(0,0), labels = scales::percent) +
# bar_y_scale_percent +
theme(panel.grid.major.y = element_blank()) +
scale_fill_manual(values = c(transcend_cols[1], transcend_cols[3])) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
labs(title = "Largest differences in core practices between<br>predominantly <span style = 'color: #1A4C81;'>BIPOC</span> and <span style = 'color: #EF464B;'>White</span> Leadership Teams",
subtitle = "When Canopy schools select the practices they use,they also have the option to\nselect up to 5 practices they consider central to their learning environment.\nThe comparison below displays the difference for the 5 practices schools selected.",
x = "",
y = "") +
theme(plot.title = element_markdown()) +
theme(legend.position = "none") +
geom_text(aes(y = .4, label = labs),
color = transcend_grays[1],
family = "sans",
size = 4)## Warning: `funs()` was deprecated in dplyr 0.8.0.
## ℹ Please use a list of either functions or lambdas:
##
## # Simple named list: list(mean = mean, median = median)
##
## # Auto named with `tibble::lst()`: tibble::lst(mean, median)
##
## # Using lambdas list(~ mean(., trim = .2), ~ median(., na.rm = TRUE))
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## `summarise()` has grouped output by 'lead'. You can override using the
## `.groups` argument.diff_core
ggsave("finding-17-V3.png", plot = diff_core, path = here("final_products", "draft-findings"),
width = 12, height = 8, units = "in")What are the biggest tagging differences between “inclusive” schools and those that are not inclusive?
We should look at modeling results to draw any strong conclusions, but I’ve created a barplot below displaying the biggest tagging differences between the two groups for the core tags selected.
I defined “inclusive” as those schools that indicated they were either designing for the needs of marginalized student groups or have all courses designed for inclusion.
Analyst note I do not trust the plot below - simple difference in tagging is good to see, however, the number of schools that fell into the “inclusive” bucket (N = 217) was far bigger than those that were not (N = 34). Might be good to think more about how to account for such a difference in sample.
inclusive_diff <-
full %>%
select(school_id, inc = practices_all_courses_designed_for_inclusion, marg = practices_design_marginalized, starts_with("core")) %>%
mutate(inclusive = case_when(
(inc == 1 | marg == 1) ~ "inclusive",
(inc == 0 & marg == 0) ~ "not"
)) %>%
select(!c(inc, marg)) %>%
rename_all(funs(sub("core", "practices", .))) %>%
select(!c(practices_all_courses_designed_for_inclusion, practices_design_marginalized)) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(inclusive, tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
pivot_wider(names_from = inclusive,
values_from = c(n, rate, pct)) %>%
mutate(diff = abs(round(100*(pct_inclusive - pct_not), 2))) %>%
pivot_longer(cols = !c(tag, diff),
names_to = c("col", "inclusive"),
names_sep = "_",
values_to = "value") %>%
pivot_wider(names_from = col,
values_from = value) %>%
arrange(desc(diff)) %>%
slice(1:20) %>%
ggplot(., aes(reorder(tag, -diff), pct, fill = inclusive)) +
geom_bar(position = "dodge", stat = "identity") +
bar_y_scale_percent +
theme(panel.grid.major.y = element_blank()) +
scale_fill_manual(values = c(transcend_cols[1], transcend_cols[3])) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
labs(title = "Largest differences in core practices between<br>schools that are <span style = 'color: #1A4C81;'>designing for inclusion</span> and <span style = 'color: #EF464B;'>not</span>",
x = "",
y = "") +
theme(plot.title = element_markdown()) +
theme(legend.position = "none")## Warning: `funs()` was deprecated in dplyr 0.8.0.
## ℹ Please use a list of either functions or lambdas:
##
## # Simple named list: list(mean = mean, median = median)
##
## # Auto named with `tibble::lst()`: tibble::lst(mean, median)
##
## # Using lambdas list(~ mean(., trim = .2), ~ median(., na.rm = TRUE))
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## `summarise()` has grouped output by 'inclusive'. You can override using the
## `.groups` argument.inclusive_diff
ggsave("finding-20.png", plot = inclusive_diff, path = here("final_products", "draft-findings"),
width = 12, height = 8, units = "in")Modification 1 - All tags
inclusive_diff3 <-
full %>%
select(school_id, inc = core_all_courses_designed_for_inclusion, marg = core_design_marginalized, starts_with("practices")) %>%
select(!c(practices_all_courses_designed_for_inclusion, practices_design_marginalized)) %>%
mutate(inclusive = case_when(
(inc == 1 | marg == 1) ~ "inclusive",
(inc == 0 & marg == 0) ~ "not"
)) %>%
select(!c(inc, marg)) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(inclusive, tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
pivot_wider(names_from = inclusive,
values_from = c(n, rate, pct)) %>%
mutate(diff = abs(round(100*(pct_inclusive - pct_not), 2))) %>%
pivot_longer(cols = !c(tag, diff),
names_to = c("col", "inclusive"),
names_sep = "_",
values_to = "value") %>%
pivot_wider(names_from = col,
values_from = value) %>%
arrange(desc(diff)) %>%
slice(1:20) %>%
ggplot(., aes(reorder(tag, -diff), pct, fill = inclusive)) +
geom_bar(position = "dodge", stat = "identity") +
bar_y_scale_percent +
theme(panel.grid.major.y = element_blank()) +
scale_fill_manual(values = c(transcend_cols[1], transcend_cols[3])) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
labs(title = "Largest differences in core practices between<br>schools that are <span style = 'color: #1A4C81;'>designing for inclusion</span> and <span style = 'color: #EF464B;'>not</span>",
subtitle = "This plot displays the 5 core tags schools selected.",
x = "",
y = "") +
theme(plot.title = element_markdown()) +
theme(legend.position = "none")## `summarise()` has grouped output by 'inclusive'. You can override using the
## `.groups` argument.inclusive_diff3
ggsave("finding-20b-V2.png", plot = inclusive_diff3, path = here("final_products", "draft-findings"),
width = 12, height = 8, units = "in")Modification 2 - Core Tags
inclusive_diff2 <-
full %>%
select(school_id, inc = core_all_courses_designed_for_inclusion, marg = core_design_marginalized, starts_with("core")) %>%
mutate(inclusive = case_when(
(inc == 1 | marg == 1) ~ "inclusive",
(inc == 0 & marg == 0) ~ "not"
)) %>%
select(!c(inc, marg)) %>%
rename_all(funs(sub("core", "practices", .))) %>%
pivot_longer(cols = starts_with("practices"),
names_to = "tag",
values_to = "n") %>%
select(!school_id) %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(inclusive, tag) %>%
summarize(n = sum(n),
rate = sum(rate),
pct = n/rate) %>%
ungroup() %>%
pivot_wider(names_from = inclusive,
values_from = c(n, rate, pct)) %>%
mutate(diff = abs(round(100*(pct_inclusive - pct_not), 2))) %>%
pivot_longer(cols = !c(tag, diff),
names_to = c("col", "inclusive"),
names_sep = "_",
values_to = "value") %>%
pivot_wider(names_from = col,
values_from = value) %>%
arrange(desc(diff)) %>%
slice(1:20) %>%
ggplot(., aes(reorder(tag, -diff), pct, fill = inclusive)) +
geom_bar(position = "dodge", stat = "identity") +
bar_y_scale_percent +
theme(panel.grid.major.y = element_blank()) +
scale_fill_manual(values = c(transcend_cols[1], transcend_cols[3])) +
scale_x_discrete(labels = label_tags(wrap = 25)) +
coord_flip() +
labs(title = "Largest differences in core practices between<br>schools that are <span style = 'color: #1A4C81;'>designing for inclusion</span> and <span style = 'color: #EF464B;'>not</span>",
x = "",
y = "") +
theme(plot.title = element_markdown()) +
theme(legend.position = "none")## Warning: `funs()` was deprecated in dplyr 0.8.0.
## ℹ Please use a list of either functions or lambdas:
##
## # Simple named list: list(mean = mean, median = median)
##
## # Auto named with `tibble::lst()`: tibble::lst(mean, median)
##
## # Using lambdas list(~ mean(., trim = .2), ~ median(., na.rm = TRUE))
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## `summarise()` has grouped output by 'inclusive'. You can override using the
## `.groups` argument.inclusive_diff2
ggsave("finding-20a-V2.png", plot = inclusive_diff2, path = here("final_products", "draft-findings"),
width = 12, height = 8, units = "in")#model usage
model_usage<-
full %>%
select(school_id, starts_with("model")) %>%
mutate(any = case_when(
model_usage_bpl == 2 ~ 1,
model_usage_ele == 2 ~ 1,
model_usage_ib == 2 ~ 1,
model_usage_ntn == 2 ~ 1,
model_usage_oc == 2 ~ 1,
model_usage_sl == 2 ~ 1
)) %>%
select(school_id, any) %>%
unique() %>%
mutate(rate = rep(1, nrow(.))) %>%
group_by(any) %>%
summarize(sum = sum(rate, na.rm = TRUE),
pct = sum/251)